home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group94a.txt / 000129_icon-group-sender _Sat May 14 07:45:39 1994.msg < prev    next >
Internet Message Format  |  1994-08-19  |  7KB
  1. Received: by cheltenham.cs.arizona.edu; Sat, 14 May 1994 10:06:26 MST
  2. Date: Sat, 14 May 1994 07:45:39 -0600 (CST)
  3. From: Chris Tenaglia - 257-8765 <TENAGLIA@MIS.MCW.EDU>
  4. Subject: X-icon for Friday 13
  5. To: icon-group@cs.arizona.edu
  6. Message-Id: <01HCBLC3VIUQ8WWR6B@mis.mcw.edu>
  7. Organization: Medical College of Wisconsin (Milwaukee, WI)
  8. X-Vms-To: IN%"icon-group@cs.arizona.edu"
  9. Mime-Version: 1.0
  10. Content-Type: TEXT/PLAIN; CHARSET=US-ASCII
  11. Content-Transfer-Encoding: 7BIT
  12. Status: R
  13. Errors-To: icon-group-errors@cs.arizona.edu
  14.  
  15. For Friday the 13th I'd like to post a little something for those
  16. with a little bit of superstition. This is a biorythm plotter.
  17. I thought it was a good excersize for X programming. I may not
  18. have a full understanding of the cycles but basically it it plots
  19. out 3 sine waves given a birthdate and year. It's not bulletproof
  20. but it does multiple windows, and even has a different mouse
  21. cursor for each window. This was written in Icon V8.10 and tested
  22. on VAX/VMS 5.5 and Ultrix unix 4.3. It isn't the best sample of
  23. Icon programming practice (I like global variables), but maybe it'll
  24. spurr some ideas. Enjoy!
  25.  
  26. (I'm sending to the list too since I'm not sure if the postnews was working)
  27.  
  28. #
  29. # file : bior.icn
  30. # desc : for those with biorythm superstition
  31. #
  32. # update          by          what
  33. # 12-may-1994     tenaglia    initial write
  34. #
  35. global xw1,xw2,         # display windows
  36.        Birth_Date,      # birth date
  37.        Plot_Year,       # month to plot
  38.        age              # days old
  39. #
  40. # main line procedure
  41. #
  42. procedure main()
  43.           get_birth_date_and_plot_month()
  44.           draw_picture()
  45. end
  46.  
  47. #
  48. # draw the graph and plot the waveforms
  49. #
  50. procedure draw_picture()
  51.   names     := ["JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE",
  52.                 "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"]
  53.   shifts    := [0,31,60,91,121,152,182,213,244,274,305,335]
  54.   pi        := 3.1415927
  55.   pi2       := pi*2.0
  56.   sumcolor  := "pink"
  57.   
  58.   (xw2 := open("BIOR " || Plot_Year || " VIA " || Birth_Date,"x",
  59.                    "bg=black","fg=white",
  60.                    "geometry=1098x200+50+500")) |
  61.     {
  62.     write("Can't open window. Press <RETURN>")
  63.     stop("ABEND ANOX")
  64.     }
  65.   write(xw1,"")
  66.   XAttrib(xw2,"pointer=heart")
  67.   XAttrib(xw1,"fg=red")
  68.   write(xw1,"          PHYSIO")
  69.   XAttrib(xw1,"fg=green")
  70.   write(xw1,"          EMOTA")
  71.   XAttrib(xw1,"fg=yellow")
  72.   write(xw1,"          INTELLA")
  73.   XAttrib(xw1,"fg=" || sumcolor)
  74.   write(xw1,"          SUMUM")
  75.   XAttrib(xw1,"fg=white")
  76.   XSync(xw1)
  77.   
  78.   XDrawLine(xw2,0,100,1098,100)
  79.   every n := 2 to *shifts do
  80.     {
  81.     disp := shifts[n]*3
  82.     XDrawLine(xw2,disp,0,disp,200)
  83.     }
  84.   a := 1
  85.   every n := 5 to 1095 by 91 do
  86.     {
  87.     XDrawString(xw2,n,10,names[a])
  88.     a +:= 1
  89.     }
  90.   every begin := !shifts do
  91.     {
  92.     every base := 5 to 25 by 5 do
  93.       {
  94.       disp := begin * 3 + base * 3
  95.       XDrawLine(xw2,disp,95,disp,105)
  96.       }
  97.     }     
  98.   oldx  := 0
  99.      x  := 0
  100.   magn  := 34
  101.   oldyp := sin((age%23)*pi2/23)*magn + 200
  102.   oldye := sin((age%28)*pi2/28)*magn + 200
  103.   oldyi := sin((age%33)*pi2/33)*magn + 200
  104.   oldyy :=(sin((age%23)*pi2/23) +
  105.            sin((age%28)*pi2/28) +
  106.            sin((age%33)*pi2/33))*magn + 100
  107.   every point := age to age + 365 do
  108.     {
  109.     yp := sin((point%23)*pi2/23)*magn + 100
  110.     ye := sin((point%28)*pi2/28)*magn + 100
  111.     yi := sin((point%33)*pi2/33)*magn + 100
  112.     yy :=(sin((point%23)*pi2/23) +
  113.           sin((point%28)*pi2/28) +
  114.           sin((point%33)*pi2/33))*magn + 100
  115.     XAttrib(xw2,"fg=red")
  116.     XDrawSegment(xw2,oldx,oldyp,x,yp)
  117.     XAttrib(xw2,"fg=green")
  118.     XDrawSegment(xw2,oldx,oldye,x,ye)
  119.     XAttrib(xw2,"fg=yellow")
  120.     XDrawSegment(xw2,oldx,oldyi,x,yi)
  121.     XAttrib(xw2,"fg=" || sumcolor)
  122.     XDrawSegment(xw2,oldx,oldyy,x,yy)
  123.     XSync(xw2)
  124.     oldyp := yp
  125.     oldye := ye
  126.     oldyi := yi
  127.     oldyy := yy
  128.     oldx  := x
  129.     x    +:= 3
  130.     }
  131.   XAttrib(xw2,"fg=white")
  132.   write("Click the Button!")
  133.   press := open("Respond Please","x",
  134.                 "geometry=200x50+500+350","fg=black","bg=green")
  135.   XAttrib(press,"pointer=leftbutton")
  136.   XDrawString(press,20,30,"Click Me to finish ")
  137.   XEvent(press)
  138.   close(press)
  139.   close(xw1)
  140.   close(xw2)
  141.   end         
  142.   
  143. #
  144. # obtain starting information
  145. #
  146. procedure get_birth_date_and_plot_month()
  147.   (xw1 := open("BIOR","x",
  148.                    "bg=black","fg=white",
  149.                    "lines=12","columns=40")) |
  150.     {
  151.     write("Can't open window. Press <RETURN>")
  152.     stop("#1 ABEND ANOX")
  153.     }
  154.   XAttrib(xw1,"pointer=exchange")
  155.   XGotoRC(xw1,1,1)
  156.   write(xw1,"Enter Dates")
  157.   XGotoRC(xw1,3,1)
  158.   write(xw1,"BirthDate  MM/DD/YYYY:")
  159.   XGotoRC(xw1,5,1)
  160.   write(xw1,"    Year to plot YYYY:")
  161.   XAttrib(xw1,"cursor=on")
  162.   XGotoRC(xw1,3,23)
  163.   Birth_Date := read(xw1)
  164.   XGotoRC(xw1,5,23)
  165.   Plot_Year := read(xw1)
  166.   base1 := 0
  167.   d1 := julian(Birth_Date)
  168.   d2 := julian("01/01/" || Plot_Year)
  169.   age:= d2 - d1
  170.   end                 
  171.  
  172. #
  173. # parse a string into a list with respect to a delimiter
  174. #
  175. procedure parse(line,delims)
  176.   static chars
  177.   chars  := &cset -- delims
  178.   tokens := []
  179.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  180.   return tokens
  181.   end
  182.  
  183. #
  184. # this procedure finds the julian number of a day given MM/DD/YYYY
  185. #
  186. procedure julian(date)
  187.   static  months,shifts
  188.   initial {
  189.           months := [31,28,31,30,31,30,31,31,30,31,30,31]
  190.           shifts := [0,31,59,90,120,151,181,212,243,273,304,334]
  191.           }
  192.   part   := parse(date,'-/')
  193.   (mm    := integer(part[1])) | stop("julian(mm/dd/yyyy) format violation #1")
  194.   (dd    := integer(part[2])) | stop("julian(mm/dd/yyyy) format violation #2")
  195.   (yyyy  := integer(part[3])) | stop("julian(mm/dd/yyyy) format violation #3")
  196.   (*part = 3)                 | stop("julian(mm/dd/yyyy) format violation #4")
  197.   if yyyy%4 = 0 then
  198.     {
  199.     months[2] := 29
  200.     shifts    := [0,31,60,91,121,152,182,213,244,274,305,335]
  201.     }
  202.   if (mm<1) | (mm>12) then stop("julian(MM/dd/yyyy) range error!")
  203.   maxd := months[mm]
  204.   if (dd<1) | (dd>maxd) then stop("julian (mm/DD/yyyy) range error!")
  205.   if yyyy < 100 then yyyy +:= 1900
  206.   if (yyyy<1901) | (yyyy>2100) then stop("julian (mm/dd/YYYY) range error!")
  207.   number  := shifts[mm] + dd
  208.   every i := 1901 to yyyy do
  209.     {
  210.     yl      := if (i%4)=0 then 366 else 365
  211.     number +:= yl
  212.     }
  213.   return number
  214.   end
  215.   
  216. -- 
  217. Chris Tenaglia   (system manager)     |  tenaglia@mis.mcw.edu
  218. Medical College of Wisconsin          |
  219. 8701 W. Watertown Plank Rd.           |  Ce que vous voyez est
  220. Milwaukee, WI 53226   (414)257-8765   |  ce que vous obtenez !
  221.  
  222.